perm filename LLAP[IL,LSP] blob sn#204361 filedate 1976-03-02 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(DEFPROP GWD 
C00004 ENDMK
CāŠ—;
(DEFPROP GWD 
 (LAMBDA(X)
  (NUMVAL (PROG (WRD FLD)
	(SETQ FLD
	      (QUOTE
	       ((22 . -1) (27 . 17) (0 . 777777) (22 . 777777))))
	(SETQ WRD 0)
	(MAPC (FUNCTION
		 (LAMBDA(ZZ)
		  (PROG2 (SETQ WRD
			       (*PLUS WRD
				     (LSH (BOOLE 1
						 (CDAR FLD)
       						 (LAPEVAL ZZ))
					  (CAAR FLD))))
			 (SETQ FLD (CDR FLD)))))
 		X)
	(COND ((AND (CONSP (CADDR X))
		    (MEMQ (CAADDR X) @(QUOTE E))
	            (NEQ (CADDDR X) @S))
	       (SETQ WRD (*PLUS (*DIF WRD (EXAMINE 11)) (LSH 11 22))) ))
	(COND ((EQ (CADDDR X) (QUOTE S))
	       (SETQ WRD (*DIF WRD (EXAMINE 11)))))
	(RETURN WRD)))) 
EXPR)